home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PASCALL / SHAPES / POLYGONY.PAS < prev   
Pascal/Delphi Source File  |  1993-06-08  |  4KB  |  177 lines
  1. unit polygony;
  2. interface
  3. uses
  4.    Graph,Objects;
  5. type
  6.    TDoint=object
  7.       X,Y:Real;
  8.       Size:Real;
  9.    end;
  10.    PDot=^TDot;
  11.    TDot=object(TObject)
  12.       change                                       ,
  13.       count                                        ,
  14.       color                                        :     Integer;
  15.       was                                          ,
  16.       iss                                          ,
  17.       wlb                                          ,
  18.       slp                                          :     TDoint;
  19.       constsize                                    :     Boolean;
  20.  
  21.     constructor Init(R,C,Cor,Sez:integer);
  22.       procedure Jump;                                    virtual;
  23.       procedure Bounce;                                  virtual;
  24.       procedure Seet(var A:TDoint);                      virtual;
  25.       procedure Draw;                                    virtual;
  26.       procedure Cycle;                                   virtual;
  27.       procedure Doer;                                    virtual;
  28.       procedure ReNew;                                   virtual;
  29.    end;
  30.  
  31.  
  32.    PBall=^TBall;
  33.    TBall=object(TDot)
  34.       procedure Draw;                                    virtual;
  35.    end;
  36.  
  37.  
  38.    PBox=^TBox;
  39.    TBox=object(TDot)
  40.       procedure Draw;                                    virtual;
  41.    end;
  42.  
  43.  
  44.  
  45. implementation
  46. {TObject.TDot}
  47. procedure   TDot.ReNew;
  48. begin
  49.    Seet(slp);
  50.    change:=Random(1000)+1;
  51.    count:=0;
  52.    constsize:=(random(2)=1);
  53. end;
  54. procedure   TDot.Doer;
  55. begin
  56.    if count>=change then ReNew;
  57.    Cycle;
  58.    Inc(Count);
  59. end;
  60. procedure   TDot.Cycle;
  61. begin
  62.    Jump;
  63.    Draw;
  64. end;
  65. procedure   TDot.Seet(var A:TDoint);
  66. begin
  67.    a.size:=2*((random(getmaxy div 8)+1)-(getmaxy/16));
  68.    a.x:=2*((random(ABS(Round(a.size)))+1)-(a.size/2));
  69.    a.y:=2*((random(ABS(Round(a.size)))+1)-(a.size/2));
  70.    a.size:=a.size/8;
  71. end;
  72. constructor TDot.Init(R,C,Cor,Sez:Integer);
  73. begin
  74.    inherited Init;
  75.    color:=C;
  76.    change:=100;
  77.    case Cor Mod 4 of
  78.       0: begin
  79.             was.x:=R;          was.y:=R;
  80.          end;
  81.       1: begin
  82.             was.x:=R;          was.y:=getmaxy-R;
  83.          end;
  84.       2: begin
  85.             was.x:=getmaxx-R;  was.y:=getmaxy-R;
  86.          end;
  87.       3: begin
  88.             was.x:=getmaxx-R;  was.y:=R;
  89.          end;
  90.    end;
  91.    was.size:=R;
  92.    iss:=was;
  93.    wlb:=iss;
  94.    constsize:=(sez=1);
  95.    ReNew;
  96. end;
  97. procedure   TDot.Draw;
  98. begin
  99.    PutPixel(Round(was.x),Round(was.y),0);
  100.    PutPixel(Round(iss.x),Round(iss.y),color);
  101. end;
  102. procedure   TDot.Jump;
  103. begin
  104.    was:=iss;
  105.    iss:=wlb;
  106.    wlb.x:=wlb.x+slp.x;
  107.    wlb.y:=wlb.y+slp.y;
  108.    if Not constsize then wlb.size:=wlb.size+slp.size;
  109.    Bounce;
  110. end;
  111. procedure   TDot.Bounce;
  112.    procedure rev(var a:real);
  113.    begin
  114.       a:=-1*a;
  115.    end;
  116. begin
  117.    if (wlb.x<=wlb.size) or (wlb.x>=getmaxx-wlb.size) then
  118.    begin
  119.       wlb.x:=iss.x;
  120.       rev(slp.x);
  121.    end;
  122.    if (wlb.y<=wlb.size) or (wlb.y>=getmaxy-wlb.size) then
  123.    begin
  124.       wlb.y:=iss.y;
  125.       rev(slp.y)
  126.    end;
  127.    if (wlb.size<=1) or (wlb.size>=getmaxy/8) then
  128.    begin
  129.       wlb.size:=iss.size;
  130.       rev(slp.size)
  131.    end;
  132.    if (wlb.x-wlb.size<=0) then
  133.    begin
  134.       wlb.x:=wlb.size+1;
  135.       rev(slp.x)
  136.    end;
  137.    if (wlb.x+wlb.size>=getmaxx) then
  138.    begin
  139.       wlb.x:=getmaxx-wlb.size-1;;
  140.       rev(slp.x);
  141.    end;
  142.    if (wlb.y-wlb.size<=0) then
  143.    begin
  144.       wlb.y:=wlb.size+1;
  145.       rev(slp.y);
  146.    end;
  147.    if (wlb.y+wlb.size>=getmaxy) then
  148.    begin
  149.       wlb.y:=getmaxy-wlb.size-1;
  150.       rev(slp.y);
  151.    end;
  152. end;
  153.  
  154. {TDot.TBall}
  155. procedure   TBall.Draw;
  156. begin
  157.    setcolor(0);
  158.    circle(Round(was.x),Round(was.y),Round(was.size));
  159.    setcolor(color);
  160.    circle(Round(iss.x),Round(iss.y),Round(iss.size));
  161. end;
  162. {TDot.TBox}
  163. procedure   TBox.Draw;
  164. begin
  165.    with was do
  166.    begin
  167.       setcolor(0);
  168.       Rectangle(Round(x-size),Round(y-size),Round(x+size),Round(y+size));
  169.    end;
  170.    with iss do
  171.    begin
  172.       setcolor(color);
  173.       Rectangle(Round(x-size),Round(y-size),Round(x+size),Round(y+size));
  174.    end;
  175. end;
  176.  
  177. end.